home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / sim756_Fil2080928282007.psc / Source Code / fspExt / fspSelFld.bas < prev   
BASIC Source File  |  2007-05-18  |  2KB  |  61 lines
  1. Attribute VB_Name = "fspSelFld"
  2. '====================================================================================
  3. 'ADDITIONAL API
  4. '====================================================================================
  5. '
  6. 'DEVELOPER(S)
  7. 'Sadequl Islam Mithun 756
  8. '<sim756@gmail.com>
  9. '<http://sim756.googlepages.com
  10. '
  11. '<NAME>
  12. '<EMAIL>
  13. '<WEB>
  14. '
  15. '====================================================================================
  16.  
  17. Public Const BIF_RETURNONLYFSDIRS = 1
  18. Public Const BIF_DONTGOBELOWDOMAIN = 2
  19. Public Const MAX_PATH = 260
  20.  
  21. Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  22. Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  23. Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  24.  
  25. Public Type BrowseInfo
  26.     hWndOwner      As Long
  27.     pIDLRoot       As Long
  28.     pszDisplayName As Long
  29.     lpszTitle      As Long
  30.     ulFlags        As Long
  31.     lpfnCallback   As Long
  32.     lParam         As Long
  33.     iImage         As Long
  34. End Type
  35.  
  36. Public Function SelFolder(ahWnd As Long) As String
  37.     On Error Resume Next
  38.     tmp = fspForm1.Text4.Text
  39.     Dim lpIDList As Long
  40.     Dim sBuffer As String
  41.     Dim szTitle As String
  42.     Dim tBrowseInfo As BrowseInfo
  43.     szTitle = "Select any Driver or Folder"
  44.     With tBrowseInfo
  45.         .hWndOwner = ahWnd
  46.         .lpszTitle = lstrcat(szTitle, "")
  47.         .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
  48.     End With
  49.     lpIDList = SHBrowseForFolder(tBrowseInfo)
  50.     If (lpIDList) Then
  51.         sBuffer = Space(MAX_PATH)
  52.         SHGetPathFromIDList lpIDList, sBuffer
  53.         sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  54.         fspForm1.Text4.Text = sBuffer
  55.     Else
  56.         fspForm1.Text4.Text = tmp
  57.     End If
  58. End Function
  59.  
  60.  
  61.